perm filename FUCK[900,BGB] blob
sn#129586 filedate 1974-11-11 generic text, type T, neo UTF8
(SETQ IBASE (ADD1 7))
(DEFPROP ALLFNS
(NIL LOW-RES-HI-CON
GETCOL
DUMPCOL
FF
OPEN
#24750
TVB
TVA
MINT3
ZLOOP
TV0
MINT2
MINT1
X1
X2
X3
X4
Y1
Y2
Y3
Y4
Z1
Z2
TV4
TV3
TV2
TV1
WAVE
TRAC
MOMENT
MEANX
MEANY
PSTAR
FINI3
DDD
DPAC
DDAC
SORT2
SORT
CROSSZ
HIST
DIFFS
CROSSINGS
PFLIP
PSET
PZIP
PNOT
MOVE
PXOR
PIOR
PAND
GETBUF
DUMPBUF
INITFLIP
SAFE
EXB
PLZ2
NLZ2
PBUF
PPAC
PLZ
NLZ
FINIT
FINI2)
VALUE)
(DEFPROP LOW-RES-HI-CON
(LAMBDA NIL
(PROG NIL
(ZIP)
(DSKTV 0 0 4 4)
(TVADD 0)
(DSKTV 0 1 4 4)
(TVADD 0)
(DSKTV 0 2 4 4)
(TVADD 0)
(DSKTV 0 3 4 4)
(TVADD 0)
(DSKTV 1 0 4 4)
(TVADD 0)
(DSKTV 1 1 4 4)
(TVADD 0)
(DSKTV 1 2 4 4)
(TVADD 0)
(DSKTV 1 3 4 4)
(TVADD 0)
(DSKTV 2 0 4 4)
(TVADD 0)
(DSKTV 2 1 4 4)
(TVADD 0)
(DSKTV 2 2 4 4)
(TVADD 0)
(DSKTV 2 3 4 4)
(TVADD 0)
(DSKTV 3 0 4 4)
(TVADD 0)
(DSKTV 3 1 4 4)
(TVADD 0)
(DSKTV 3 2 4 4)
(TVADD 0)
(DSKTV 3 3 4 4 4)
(TVADD 0)))
EXPR)
(DEFPROP GETCOL
(LAMBDA(FILE)
(PROG (N M)
(EVAL (LIST (QUOTE INPUT) (QUOTE DSK:) FILE))
(INC T)
(SETQ M (PLUS))
(SETQ N CLRS)
L (DEPOSIT N (READ))
(COND ((GREATERP M (SETQ N (ADD1 N))) (GO L)))
(INC NIL)
(RETURN NIL)))
EXPR)
(DEFPROP DUMPCOL
(LAMBDA NIL
(PROG (N M)
(SETQ N CLRS)
(SETQ M (PLUS 11000 N))
L (PRINT (EXAMINE N))
(COND ((GREATERP M (SETQ N (ADD1 N))) (GO L)))))
EXPR)
(DEFPROP FF
(LAMBDA(N)
(PROG NIL
(TV1)
(TVADD N)
(TV1)
(TVADD N)
(TV1)
(TVADD N)
(TV1)
(TVADD N)
(TV1)
(TVADD N)
(TV1)
(TVADD N)
(TV1)
(TVADD N)
(TV1)
(TVADD N)))
EXPR)
(DEFPROP OPEN
(LAMBDA NIL (JOINT 7 100))
EXPR)
(DEFPROP #24750
(LAMBDA NIL (JOINT 7 -110))
EXPR)
(DEFPROP TVB
(LAMBDA NIL (TV X0 Y0 ZB))
EXPR)
(DEFPROP TVA
(LAMBDA NIL (TV X0 Y0 ZA))
EXPR)
(DEFPROP MINT3
(LAMBDA NIL NIL)
EXPR)
(DEFPROP ZLOOP
(LAMBDA NIL (PROG NIL L (TV0) (COND ((ZEROP (#23550)) (GO L)))))
EXPR)
(DEFPROP TV0
(LAMBDA NIL (TV X0 Y0 Z0))
EXPR)
(DEFPROP MINT2
(LAMBDA NIL (PROG NIL (DEPOSIT JOY 0) (JOINT 7 100)))
EXPR)
(DEFPROP MINT1
(LAMBDA NIL
(PROG NIL
L (ZIP)
(TV3)
(TVADD 0)
(TV3)
(TVSUB 0)
(SIEVE 0 0 10 17)
(COND ((GREATERP (AREA 0) 100) (MINT2) (MINT3)))
(COND ((NOT (ZEROP (#23550))) (GO L)))))
EXPR)
(DEFPROP X1
(NIL . 200)
VALUE)
(DEFPROP X2
(NIL . 140)
VALUE)
(DEFPROP X3
(NIL . 200)
VALUE)
(DEFPROP X4
(NIL . 140)
VALUE)
(DEFPROP Y1
(NIL . 300)
VALUE)
(DEFPROP Y2
(NIL . 240)
VALUE)
(DEFPROP Y3
(NIL . 200)
VALUE)
(DEFPROP Y4
(NIL . 140)
VALUE)
(DEFPROP Z1
(NIL . 701002)
VALUE)
(DEFPROP Z2
(NIL . 700102)
VALUE)
(DEFPROP TV4
(LAMBDA NIL (TV X4 Y4 Z2))
EXPR)
(DEFPROP TV3
(LAMBDA NIL (TV X3 Y3 Z1))
EXPR)
(DEFPROP TV2
(LAMBDA NIL (TV X2 Y2 Z2))
EXPR)
(DEFPROP TV1
(LAMBDA NIL (TV X1 Y1 Z1))
EXPR)
(DEFPROP WAVE
(LAMBDA(J MIN MAX F)
(PROG NIL
L (JOINT J MIN)
L1 (COND ((ZEROP (EXAMINE (PLUS JOY (SUB1 J)))) (GO L2)))
(F)
(COND ((ZEROP (#23550)) (RETURN NIL)))
(GO L1)
L2 (JOINT J MAX)
L3 (COND ((ZEROP (EXAMINE (PLUS JOY (SUB1 J)))) (GO L)))
(F)
(COND ((ZEROP (#23550)) (RETURN NIL)))
(GO L3)))
EXPR)
(DEFPROP TRAC
(LAMBDA NIL
(PROG (XX YY)
L (TV X Y Z)
(ZIP)
(TVADD 0)
(HISTO 0)
(SIEVE 0 0 0 1)
(COND ((ZEROP (AREA 0)) (GO L)))
(SETQ XX (DIFFERENCE (MEANX 0) 40))
(SETQ YY (DIFFERENCE (MEANY 0) 40))
(SETQ X (PLUS X XX))
(SETQ Y (DIFFERENCE Y YY))
L2 (PAN (PLUS (PPP) (FIX (TIMES KX (DIFFERENCE X 140)))))
(TILT (PLUS (TTT) (FIX (TIMES KY (DIFFERENCE 300 Y)))))
(COND ((NOT (ZEROP (#23550))) (RETURN NIL)))
(GO L)))
EXPR)
(DEFPROP MOMENT
(LAMBDA(N)
(PROG (A B C D)
(SETQ A (PLUS 0.0 (AREA N)))
(SETQ B (QUOTIENT (SUMX N) A))
(SETQ D (SUMSQX))
(SETQ C (QUOTIENT (SUMY N) A))
(RETURN (DIFFERENCE (PLUS D (SUMSQY)) (TIMES A B B) (TIMES A C C)))))
EXPR)
(DEFPROP MEANX
(LAMBDA (N) (QUOTIENT (SUMX N) (AREA N)))
EXPR)
(DEFPROP MEANY
(LAMBDA (N) (QUOTIENT (SUMY N) (AREA N)))
EXPR)
(DEFPROP PSTAR
(LAMBDA(Z)
(PROG (ZZ)
(SETQ ZZ Z)
L (COND ((NULL ZZ) (RETURN NIL)))
(PRINC (BLANKS (CAR ZZ)))
(SETQ ZZ (CDR ZZ))
(GO L)))
EXPR)
(DEFPROP FINI3
(LAMBDA NIL
(PROG NIL
(STORE (BLANKS 0) (QUOTE " "))
(STORE (BLANKS 1) (QUOTE " *"))
(STORE (BLANKS 2) (QUOTE " * "))
(STORE (BLANKS 3) (QUOTE " **"))
(STORE (BLANKS 4) (QUOTE "* "))
(STORE (BLANKS 5) (QUOTE "* *"))
(STORE (BLANKS 6) (QUOTE "** "))
(STORE (BLANKS 7) (QUOTE "***"))))
EXPR)
(DEFPROP DDD
(LAMBDA(A)
(PROG NIL
(TYI)
(TYI)
(DDAC A 0 1000)
(TYI)
(DDAC A 1 500)
(TYI)
(DDAC A 2 200)
(TYI)
(DDAC A 3 -100)
(TYI)
(DDAC A 4 -400)
(TYI)
(DDAC A 5 1000)
(TYI)
(DDAC A 6 500)
(TYI)
(DDAC A 7 200)
(TYI)
(CLEAR)
(KILL 0)))
EXPR)
(DEFPROP DPAC
(LAMBDA(A E)
(PROG (B C D)
(SETQ B (PLUS (TIMES 200 A) (TIMES 20 E) PC))
(SETQ C (PLUS B 20))
L (SETQ D (EXAMINE B))
(COND ((MINUSP D) (NLZ D)) (T (PLZ D)))
(SETQ D (EXAMINE (ADD1 B)))
(COND ((MINUSP D) (NLZ D)) (T (PLZ D)))
(TERPRI)
(COND ((EQ (SETQ B (PLUS 2 B)) C) (RETURN NIL)))
(GO L)))
EXPR)
(DEFPROP DDAC
(LAMBDA(A B C)
(PROG NIL (KILL 0) (CLEAR) (CHINIT 0 112 -777) (AIVECT -777 C) (DTYOS) (DPAC A B) (DTYOU) (SHOW 0)))
EXPR)
(DEFPROP SORT2
(LAMBDA (N M Z) (COND ((NULL (CDR Z)) N) (T (PROG2 (SIEVE N M (CAR Z) (CADR Z)) (SORT2 (ADD1 N) M (CDR Z))))))
EXPR)
(DEFPROP SORT
(LAMBDA(N M)
(PROG (Z)
(SETQ Z (CROSSZ M))
(RETURN
(COND ((NULL (CDR Z)) N) (T (PROG2 (SIEVE N M (CAR Z) (CADR Z)) (SORT2 (ADD1 N) M (CDR Z))))))))
EXPR)
(DEFPROP CROSSZ
(LAMBDA (N) (APPEND (CONS 0 (CROSSINGS (DIFFS (HIST N)) 1)) (QUOTE (20))))
EXPR)
(DEFPROP HIST
(LAMBDA(N)
(PROG (M Z)
(SETQ M 17)
(SETQ Z NIL)
L (SETQ Z (CONS (EXAMINE (PLUS (TIMES 20 N) HSTV M)) Z))
(COND ((EQ -1 (SETQ M (SUB1 M))) (RETURN Z)) (T (GO L)))))
EXPR)
(DEFPROP DIFFS
(LAMBDA (Z) (COND ((NULL (CDR Z)) NIL) (T (CONS (DIFFERENCE (CAR Z) (CADR Z)) (DIFFS (CDR Z))))))
EXPR)
(DEFPROP CROSSINGS
(LAMBDA(Z N)
(COND ((NULL (CDR Z)) NIL)
(T
(COND ((AND (MINUSP (CADR Z)) (NOT (MINUSP (CAR Z)))) (CONS N (CROSSINGS (CDR Z) (ADD1 N))))
(T (CROSSINGS (CDR Z) (ADD1 N)))))))
EXPR)
(DEFPROP PFLIP
(LAMBDA (A) (LOGIC 12 A A))
EXPR)
(DEFPROP PSET
(LAMBDA (A) (LOGIC 17 A A))
EXPR)
(DEFPROP PZIP
(LAMBDA (A) (LOGIC 0 A A))
EXPR)
(DEFPROP PNOT
(LAMBDA (A B) (LOGIC 12 A B))
EXPR)
(DEFPROP MOVE
(LAMBDA (A B) (LOGIC 5 A B))
EXPR)
(DEFPROP PXOR
(LAMBDA (A B) (LOGIC 6 A B))
EXPR)
(DEFPROP PIOR
(LAMBDA (A B) (LOGIC 7 A B))
EXPR)
(DEFPROP PAND
(LAMBDA (A B) (LOGIC 1 A B))
EXPR)
(DEFPROP GETBUF
(LAMBDA(FILE)
(PROG (N M)
(EVAL (LIST (QUOTE INPUT) (QUOTE DSK:) FILE))
(INC T)
(SETQ M (PLUS BFFR 1000))
(SETQ N BFFR)
L (DEPOSIT N (READ))
(COND ((GREATERP M (SETQ N (ADD1 N))) (GO L)))
(INC NIL)
(RETURN NIL)))
EXPR)
(DEFPROP DUMPBUF
(LAMBDA NIL
(PROG (N M)
(SETQ N BFFR)
(SETQ M (PLUS 1000 N))
L (PRINT (EXAMINE N))
(COND ((GREATERP M (SETQ N (ADD1 N))) (GO L)))))
EXPR)
(DEFPROP INITFLIP
(LAMBDA NIL
(PROG NIL
(ARRAY ZEROES T 44)
(ARRAY BLANKS T 10)
(FINIT)
(FINI2)
(FINI3)
(SETQ BFFR (CAR (GETSYM VAL BUFFER)))
(SETQ HSTV (CAR (GETSYM VAL HISTOV)))
(SETQ CLRS (CAR (GETSYM VAL COLORS)))
(SETQ PC (CAR (GETSYM VAL PAC)))))
EXPR)
(DEFPROP SAFE
(LAMBDA NIL (DSKOUT FUCK (GRINL ALLFNS)))
EXPR)
(DEFPROP EXB
(LAMBDA (G H) (PROG (V) (SETQ V (EXAMINE (PLUS G H))) (COND ((MINUSP V) (NLZ2 V)) (T (PLZ2 V)))))
EXPR)
(DEFPROP PLZ2
(LAMBDA(N)
(PROG (M)
(SETQ M (DIFFERENCE 11 (FLATSIZE N)))
(COND ((ZEROP M) (PRINC N)) (T (PROG2 (PRINC (ZEROES M)) (PRINC N))))))
EXPR)
(DEFPROP NLZ2
(LAMBDA (N) (PROG NIL (PRINC (LSH N -4)) (PRINC (BOOLE 1 (LSH N -40) 17))))
EXPR)
(DEFPROP PBUF
(LAMBDA NIL
(PROG (B C D)
(SETQ B BFFR)
(SETQ BASE 20)
(SETQ C (PLUS B 1000))
L (EXB B 0)
(EXB B 1)
(EXB B 2)
(EXB B 3)
(EXB B 4)
(EXB B 5)
(EXB B 6)
(EXB B 7)
(TERPRI)
(COND ((EQ (SETQ B (PLUS (ADD1 7) B)) C) (RETURN (SETQ BASE (ADD1 7)))))
(GO L)))
EXPR)
(DEFPROP PPAC
(LAMBDA(A)
(PROG (B C D)
(SETQ B (PLUS (TIMES 200 A) PC))
(SETQ C (PLUS B 200))
L (SETQ D (EXAMINE B))
(COND ((MINUSP D) (NLZ D)) (T (PLZ D)))
(SETQ D (EXAMINE (ADD1 B)))
(COND ((MINUSP D) (NLZ D)) (T (PLZ D)))
(TERPRI)
(COND ((EQ (SETQ B (PLUS 2 B)) C) (RETURN NIL)))
(GO L)))
EXPR)
(DEFPROP PLZ
(LAMBDA(N)
(PROG (M)
(SETQ M (DIFFERENCE 14 (FLATSIZE N)))
L (COND ((ZEROP M) (RETURN (PSTAR (EXPLODE N)))))
(PRINC (QUOTE " "))
(SETQ M (SUB1 M))
(GO L)))
EXPR)
(DEFPROP NLZ
(LAMBDA(N)
(PROG (M NN)
(PSTAR (NCONS (BOOLE 1 (LSH N -41) 7)))
(SETQ NN (BOOLE 1 N 77777777777))
(SETQ M (DIFFERENCE 13 (FLATSIZE NN)))
L (COND ((ZEROP M) (RETURN (PSTAR (EXPLODE NN)))))
(PRINC (QUOTE " "))
(SETQ M (SUB1 M))
(GO L)))
EXPR)
(DEFPROP FINIT
(LAMBDA NIL
(PROG2 (GETSYM SUBR DDT ARM DAC JOINT TSINIT LENS #23550 ZIP TVADD TVSUB FOCUS PAN TILT)
(GETSYM SUBR
LOGIC
HISTO
SIEVE
CLIY1
CLIY2
CLIX
PACKBUF
PACK
XMINW
AREA
YMIN
YMAX
YBLIT
XSHIFT
SUMY
SUMSQY
SUMX
IMULC
ADDC
TV
GRAD
PPP
TTT
FFF
STOPWAR
ASHV
SUMSQX)
(GETSYM VALUE HISTOV PAC BUFFER)))
EXPR)
(DEFPROP FINI2
(LAMBDA NIL
(PROG NIL
(STORE (ZEROES 1) (QUOTE "0"))
(STORE (ZEROES 2) (QUOTE "00"))
(STORE (ZEROES 3) (QUOTE "000"))
(STORE (ZEROES 4) (QUOTE "0000"))
(STORE (ZEROES 5) (QUOTE "00000"))
(STORE (ZEROES 6) (QUOTE "000000"))
(STORE (ZEROES 7) (QUOTE "0000000"))
(STORE (ZEROES 10) (QUOTE "00000000"))
(STORE (ZEROES 11) (QUOTE "000000000"))
(STORE (ZEROES 12) (QUOTE "0000000000"))
(STORE (ZEROES 13) (QUOTE "00000000000"))
(STORE (ZEROES 14) (QUOTE "000000000000"))
(STORE (ZEROES 15) (QUOTE "0000000000000"))
(STORE (ZEROES 16) (QUOTE "00000000000000"))
(STORE (ZEROES 17) (QUOTE "000000000000000"))
(STORE (ZEROES 20) (QUOTE "0000000000000000"))
(STORE (ZEROES 21) (QUOTE "00000000000000000"))
(STORE (ZEROES 22) (QUOTE "000000000000000000")))
NIL)
EXPR)